home *** CD-ROM | disk | FTP | other *** search
/ Language/OS - Multiplatform Resource Library / LANGUAGE OS.iso / t3_1 / risc_src.lha / risc_sources / sys / unix_vmport.t < prev    next >
Text File  |  1989-09-26  |  7KB  |  223 lines
  1. (herald unix_vmport
  2.   (env tsys
  3.        (osys unix_fault)
  4.        (osys buffer)))
  5.  
  6. ;;; The Unix interface to I/O routines.
  7.  
  8. ;;; This file contains the virtual machine I/O interface to the
  9. ;;; aegis operating system.  Where possible we use IOS calls rather
  10. ;;; than say NAME calls, so that T takes advantage of Extensible
  11. ;;; ports.
  12.  
  13. ;;; Used on startup.  ** This must be a top level procedure **
  14. ;;; The losing 1's in UNIX-WRITE below are really %%stdout!
  15.  
  16. (define (%VM-BOOT-WRITE-TTY SYMBOL)
  17.   (unix-write 1 (make-pointer symbol 0) (fx- (symbol-length symbol) 4))
  18.   (let ((newline (make-text 1)))
  19.     (set (text-elt newline 0) #\newline)
  20.     (unix-write 1 newline 1)))
  21.  
  22. ;;; Z system i/o
  23.  
  24. (define-constant %%standard-input  0)
  25. (define-constant %%standard-output 1)
  26. (define-constant %%error-input     2)
  27. (define-constant %%error-output    1)
  28.  
  29. ;;; Input
  30.  
  31. (define (%VM-READ-BUFFER IOB BLOCK?)
  32.   (ignore block?)
  33.   (let ((length (unix-read (iob-channel iob)
  34.                            (iob-buffer  iob)
  35.                            (max-buffer-length iob))))
  36.     (xcond ((fx> length 0)
  37.             (set (iob-offset iob) 0)
  38.             (set (iob-limit iob) length)
  39.             (set (iob-eof-flag? iob) nil)
  40.             length)
  41.            ((fx= length 0)
  42.             (set (iob-eof-flag? iob) t)
  43.             eof)
  44.            ((fx= length -1)
  45.             (local-os-error length)))))
  46.  
  47. (define-foreign unix-read ("read" (in rep/integer)
  48.                                 (in rep/extend)
  49.                                 (in rep/integer))
  50.                 rep/integer)
  51.  
  52. ;;; Block input
  53.  
  54. (DEFINE (%VM-READ-PARTIAL-BLOCK IOB LOC)
  55.   (let* ((length (string-length loc))
  56.          (length (unix-partial-read (iob-channel iob) loc length)))
  57.     (cond ((fx> length 0)
  58.            (set (iob-eof-flag? iob) nil)
  59.            length)
  60.           ((fx= length 0)
  61.            (set (iob-eof-flag? iob) t)
  62.            (end-of-file iob))
  63.           (else
  64.            (local-os-error length)))))
  65.  
  66. (define-foreign unix-partial-read ("read" (in rep/integer)
  67.                                         (in rep/string)
  68.                                         (in rep/integer))
  69.                 rep/integer)
  70.  
  71. ;;; Output
  72.  
  73. ;;; Writing a zero length buffer is a no-op, not an error.
  74.  
  75. (define (%VM-WRITE-BUFFER IOB)
  76.   (cond ((fx> (iob-offset iob) 0)
  77.          (let ((offset (iob-offset iob))
  78.                (length (unix-write (iob-channel iob)
  79.                                    (iob-buffer  iob)
  80.                                    (iob-offset  iob))))
  81.            (set (iob-offset iob) 0)
  82.            (cond ((fxN= length offset)         
  83.                   (local-os-error length))))))
  84.   (no-value))
  85.  
  86. (define-foreign unix-write ("write" (in rep/integer)
  87.                                   (in rep/extend)
  88.                                   (in rep/integer))
  89.                 rep/integer)
  90.  
  91. ;;; Newline is system dependent because of OS's like VMS.
  92.  
  93. (define-integrable (%vm-newline iob)
  94.   (vm-write-char iob #\newline))
  95.  
  96. ;;; Block output
  97.  
  98. (define (%VM-WRITE-BLOCK IOB LOC)
  99.   (let ((length (string-length loc)))
  100.     (check-status (unix-write-string (iob-channel iob) loc length)))
  101.   (no-value))
  102.  
  103. (define-foreign unix-write-string ("write" (in rep/integer)
  104.                                          (in rep/string)
  105.                                          (in rep/integer))
  106.                 rep/integer)
  107.  
  108. (define (%VM-FORCE-OUTPUT IOB)
  109.   (check-status (unix-fsync (iob-channel iob)))
  110.   (no-value))
  111.  
  112. (define-foreign unix-fsync ("fsync" (in rep/integer))
  113.                 rep/integer)
  114.  
  115.  
  116. ;;; The rest of this file doesn't have to be implemented to get
  117. ;;; the Z System booted.
  118.  
  119. ;;; Pathnames
  120.  
  121. ;;; Pathnames are system dependent objects used for naming files
  122. ;;; internally.  They should not be accessible outside of this file.
  123.  
  124. ;;; FILESPEC    -   Something that ->FILENAME can handle
  125. ;;; FILENAME    -   The result of  ->FILENAME
  126. ;;; PATHNAME    -   A string in the LOCAL-OS format
  127. ;;; (->PATHNAME filespec) => pathname
  128.  
  129. ;;; Internal utilities
  130.  
  131. (define-constant pathname-length string-length)
  132.  
  133. ;;; ->PATHNAME provides the VM with a portable interface to the
  134. ;;; various file systems.
  135. ;++ this is consing and it shouldn't be. it should also be portable
  136.  
  137. (define (->pathname filespec)
  138.   (let* ((buf (get-string-buffer-of-size 120))
  139.          (str (string->asciz! 
  140.                (cond ((string?   filespec) filespec)
  141.                      ((iob? filespec) (iob-id filespec))
  142.                      ((not (file-system-present?))
  143.                       (error "Filespecs must be strings in VM."))
  144.                      ((filename? filespec) (filename->string filespec))
  145.                      (else
  146.                       (filename->string (->filename filespec)))))))
  147.     (set (string-length buf) 120)
  148.     (unix-expand-path str buf)
  149.     (set (string-length buf) (string-posq #\null buf))
  150.     buf))
  151.  
  152. (define-foreign unix-expand-path ("expand_path" (in rep/string)
  153.                                               (in rep/string))
  154.                 rep/integer)
  155.  
  156. ;;; File opening and closing.
  157. ;++ What about pads, sockets, etc.
  158. ;++ There should be a population of all open IOB's.
  159.  
  160. ;;; On the Apollo bench mark tests show a buffer size of 128 to
  161. ;;; be as effective as one of 512 or 1024.
  162.  
  163. (define default-buffer-size 512)
  164.  
  165. (define default-file-access #o666)
  166.  
  167. ;;; (VM-OPEN-FILE name mode access size)
  168. ;;; CALLER   - a symbol identifying the caller, used for error output.
  169. ;;; NAME     - the file to be opened, either a FILESPEC or IOB.
  170. ;;; MODESPEC - a symbol or list of symbols parsable by MODE->IOB-MODE.
  171. ;;; ACCESS   - the access mode for the file if it is being created.
  172. ;;; SIZE     - the size of the buffer to be used with this port.
  173.  
  174. ;++ this should take an access argument
  175. (define (%vm-open-file caller fd modespec size)
  176.   (let* ((path (->pathname (if (iob? fd) (iob-id fd) fd)))
  177.          (mode (mode->iob-mode caller fd modespec))
  178.          (chan (unix-open path
  179.                           (cond ((iob-mode? mode iob/read)
  180.                                  file-mode/in)
  181.                                 ((iob-mode? mode iob/write)
  182.                                  file-mode/out)
  183.                                 ((iob-mode? mode iob/inquire)
  184.                                  file-mode/in)
  185.                                 ((iob-mode? mode iob/append)
  186.                                  file-mode/append)
  187.                                 (else
  188.                                  (unsupported-mode-error caller fd modespec)))
  189.                           default-file-access)))
  190.     (release-string-buffer path)
  191.     (cond ((fx< chan 0) nil)
  192.       (else
  193.        (let* ((size (if (iob-mode? mode iob/inquire) 0 size))
  194.           (iob (get-i/o-buffer %buffer-pool fd chan mode size)))
  195. ;++               (set (table-entry open-port-table iob) (object-hash iob))
  196.          iob)))))
  197.  
  198. (define-foreign unix-open ("open" (in rep/string)
  199.                                 (in rep/integer)
  200.                                 (in rep/integer))
  201.                 rep/integer)
  202.  
  203. (define (%VM-CLOSE-FILE IOB)
  204.   (check-status (unix-close (iob-channel iob))))
  205.  
  206. (define-foreign unix-close ("close" (in rep/integer))
  207.                 rep/integer)
  208.    
  209.  
  210.  
  211. (comment
  212.   (define-foreign unix-ftruncate (ftruncate (in rep/integer)
  213.                                             (in rep/integer))
  214.                   rep/integer)
  215.  
  216.   (define-foreign unix-lseek (lseek (in rep/integer)
  217.                                     (in rep/integer)
  218.                                     (in rep/integer))
  219.                   rep/integer)
  220.  
  221. )
  222.  
  223.